home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / MISC / MAG08.ZIP / SCRLGEO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-30  |  1.9 KB  |  81 lines
  1. Program ScrollGeo;
  2.  
  3. Uses Mode13h, Sprites, Crt;
  4.  
  5. Const GeoMapSizeX=100;
  6.       GeoMapSizeY=100;
  7.  
  8. Var GeoMap:Array[0..GeoMapSizeX,0..GeoMapSizeY] Of Byte;
  9.     GeoImages:Array[1..5] Of Pointer;
  10.     A,B:Word;
  11.     C:Char;
  12.  
  13. Procedure GenGeoMap;
  14. Var A,B:Word;
  15. Begin
  16.      For A:=0 To GeoMapSizeX Do
  17.        For B:=0 To GeoMapSizeY Do
  18.          GeoMap[A,B]:=Random(5)+1;
  19. End;
  20.  
  21. Procedure LoadGeoImages(Filename:String);
  22. Var F:File;
  23.     Index:Word;
  24. Begin
  25.      Assign(F,Filename);
  26.      Reset(F,1);
  27.      Index:=1;
  28.      While Not Eof(F) Do
  29.      Begin
  30.           LoadImage(F,GeoImages[Index]);
  31.           Inc(Index);
  32.      End;
  33. End;
  34.  
  35. Procedure DispGeo(X,Y,DX,DY,Where:Word);
  36. Var A,B:Word;
  37.     C:Byte;
  38. Begin
  39.      For A:=0 To DX-1 Do
  40.        For B:=0 To DY-1 Do
  41.        Begin
  42.             C:=GeoMap[X+A,Y+B];
  43.             PutImage(A*16,B*16,GeoImages[C],Where);
  44.        End;
  45. End;
  46.  
  47. Procedure SetColors;
  48. Begin
  49.      SetColor(0,0,0,0);                 { Black }
  50.      SetColor(1,40,20,0);               { Brown }
  51.      SetColor(2,0,50,0);                { Light Green }
  52.      SetColor(3,0,25,0);                { Dark Green }
  53.      SetColor(4,0,55,60);               { Light Blue }
  54.      SetColor(5,0,0,60);                { Dark Blue }
  55.      SetColor(6,35,35,35);              { Gray }
  56. End;
  57.  
  58. Begin
  59.      { Initialization }
  60.      GenGeoMap;
  61.      LoadGeoImages('ScrlGeo.Img');
  62.      InitGraph;
  63.      SetColors;
  64.      { Move around }
  65.      { Press A to go up, Z to go down, N to go left, M to go right }
  66.      { and Q to quit. }
  67.      { The program doesn't do checking, so don't go out of bounds ! }
  68.      A:=0;
  69.      B:=0;
  70.      Repeat
  71.            DispGeo(A,B,10,10,Vga);
  72.            C:=Readkey;
  73.            If C='a' Then B:=B-1;
  74.            If C='z' Then B:=B+1;
  75.            If C='n' Then A:=A-1;
  76.            If C='m' Then A:=A+1;
  77.      Until C='q';
  78.      { Close down }
  79.      Closegraph;
  80.      For A:=1 To 5 Do KillImage(GeoImages[A]);
  81. End.